home *** CD-ROM | disk | FTP | other *** search
/ PC User 2003 January / Disc 3 / Amethyst.iso / live / usr / lib / rpm-3.0.6 / perl.prov < prev    next >
Encoding:
Text File  |  2001-04-06  |  4.6 KB  |  169 lines
  1. #!/usr/bin/perl
  2.  
  3. # RPM (and it's source code) is covered under two separate licenses.
  4.  
  5. # The entire code base may be distributed under the terms of the GNU
  6. # General Public License (GPL), which appears immediately below.
  7. # Alternatively, all of the source code in the lib subdirectory of the
  8. # RPM source code distribution as well as any code derived from that
  9. # code may instead be distributed under the GNU Library General Public
  10. # License (LGPL), at the choice of the distributor. The complete text
  11. # of the LGPL appears at the bottom of this file.
  12.  
  13. # This alternative is allowed to enable applications to be linked
  14. # against the RPM library (commonly called librpm) without forcing
  15. # such applications to be distributed under the GPL.
  16.  
  17. # Any questions regarding the licensing of RPM should be addressed to
  18. # Erik Troan <ewt@redhat.com>.
  19.  
  20. # a simple script to print the proper name for perl libraries.
  21.  
  22. # To save development time I do not parse the perl grammmar but
  23. # instead just lex it looking for what I want.  I take special care to
  24. # ignore comments and pod's.
  25.  
  26. # it would be much better if perl could tell us the proper name of a
  27. # given script.
  28.  
  29. # The filenames to scan are either passed on the command line or if
  30. # that is empty they are passed via stdin.
  31.  
  32. # If there are lines in the file which match the pattern
  33. #      (m/^\s*\$VERSION\s*=\s+/)
  34. # then these are taken to be the version numbers of the modules.
  35. # Special care is taken with a few known idioms for specifying version
  36. # numbers of files under rcs/cvs control.
  37.  
  38. # If there are strings in the file which match the pattern
  39. #     m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i
  40. # then these are treated as additional names which are provided by the
  41. # file and are printed as well.
  42.  
  43. # I plan to rewrite this in C so that perl is not required by RPM at
  44. # build time.
  45.  
  46. # by Ken Estes Mail.com kestes@staff.mail.com
  47.  
  48. if ("@ARGV") {
  49.   foreach (@ARGV) {
  50.     process_file($_);
  51.   }
  52. } else {
  53.  
  54.   # notice we are passed a list of filenames NOT as common in unix the
  55.   # contents of the file.
  56.  
  57.   foreach (<>) {
  58.     process_file($_);
  59.   }
  60. }
  61.  
  62.  
  63. foreach $module (sort keys %require) {
  64.   if (length($require{$module}) == 0) {
  65.     print "perl($module)\n";
  66.   } else {
  67.  
  68.     # I am not using rpm3.0 so I do not want spaces arround my
  69.     # operators. Also I will need to change the processing of the
  70.     # $RPM_* vairable when I upgrade.
  71.  
  72.     print "perl($module) = $require{$module}\n";
  73.   }
  74. }
  75.  
  76. exit 0;
  77.  
  78.  
  79.  
  80. sub process_file {
  81.  
  82.   my ($file) = @_;
  83.   chomp $file;
  84.   
  85.   open(FILE, "<$file")||
  86.     die("$0: Could not open file: '$file' : $!\n");
  87.  
  88.   my ($package, $version) = ();
  89.  
  90.   while (<FILE>) {
  91.     
  92.     # skip the documentation
  93.  
  94.     # we should not need to have item in this if statement (it
  95.     # properly belongs in the over/back section) but people do not
  96.     # read the perldoc.
  97.  
  98.     if ( (m/^=(head1|head2|pod|item)/) .. (m/^=(cut)/) ) {
  99.       next;
  100.     }
  101.     
  102.     if ( (m/^=(over)/) .. (m/^=(back)/) ) {
  103.       next;
  104.     }
  105.     
  106.     # skip the data section
  107.     if (m/^__(DATA|END)__$/) {
  108.       last;
  109.     }
  110.  
  111.     # not everyone puts the package name of the file as the first
  112.     # package name so we report all namespaces as if they were
  113.     # provided packages (really ugly).
  114.  
  115.     if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) {
  116.       $package=$1;
  117.       undef $version;
  118.       $require{$package}=undef;
  119.     }
  120.  
  121.     # after we found the package name take the first assignment to
  122.     # $VERSION as the version number. Exporter requires that the
  123.     # variable be called VERSION so we are safe.
  124.  
  125.     # here are examples of VERSION lines from the perl distribution
  126.  
  127.     #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
  128.     #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.3 $, 10;
  129.     #CGI/Apache.pm:$VERSION = (qw$Revision: 1.3 $)[1];
  130.     #DynaLoader.pm:$VERSION = $VERSION = "1.03";     # avoid typo warning
  131.  
  132.     if ( 
  133.     ($package) && 
  134.     (m/^\s*\$VERSION\s*=\s+/)
  135.        ) {
  136.  
  137.       # first see if the version string contains the string
  138.       # '$Revision' this often causes bizzare strings and is the most
  139.       # common method of non static numbering.
  140.  
  141.       if (m/(\$Revision: (\d+[.0-9]+))/) {
  142.     $version= $2; 
  143.       } elsif (m/[\'\"]?(\d+[.0-9]+)[\'\"]?/) {
  144.     
  145.     # look for a static number hard coded in the script
  146.     
  147.     $version= $1; 
  148.       }
  149.       $require{$package}=$version;
  150.     }
  151.     
  152.     # Each keyword can appear multiple times.  Don't
  153.     #  bother with datastructures to store these strings,
  154.     #  if we need to print it print it now.
  155.     
  156.     if ( m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i) {
  157.       foreach $_ (spit(/\s+/, $1)) {
  158.     print "$_\n";
  159.       }
  160.     }
  161.  
  162.   }
  163.  
  164.   close(FILE)||
  165.     die("$0: Could not close file: '$file' : $!\n");
  166.  
  167.   return ;
  168. }
  169.